home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Camelot / Camelot 134 (1991-10)(Swedish User Group of Amiga)(SE)(PD)[WB].zip / Camelot 134 (1991-10)(Swedish User Group of Amiga)(SE)(PD)[WB].adf / PSGraph / fun.ps next >
Text File  |  1991-05-27  |  6KB  |  476 lines
  1. /xconv  % converts function x value to point coords.
  2. {
  3. %m=(sxmax-sxmin)/(xmax-xmin)
  4. /m
  5. sxmax sxmin sub
  6. xmax xmin sub
  7. div
  8. def
  9.  
  10. %b=(sxmin-m*xmin)
  11. /b
  12.  
  13. sxmin
  14. m xmin mul
  15. sub
  16.  
  17. def
  18.  
  19. % x'=mx+b
  20.  
  21. m mul
  22. b add
  23.  
  24. }def
  25.  
  26. /yconv
  27. {
  28. %m=(symax-symin)/(ymax-ymin)
  29. /m
  30.  
  31. symax symin sub
  32. ymax ymin sub
  33. div
  34.  
  35. def
  36.  
  37. %b=(symin-m*ymin)
  38. /b
  39.  
  40. symin
  41. m ymin mul
  42. sub
  43.  
  44. def
  45.  
  46. %y'=my+b
  47.  
  48. m mul
  49. b add
  50.  
  51. }def
  52.  
  53. /conv  %stack (top) y x
  54. {
  55. yconv
  56. exch
  57. xconv
  58. exch
  59. } def
  60.  
  61. /plotline %stack(top) y2 x2 y1 x1 graylevel
  62. {
  63. newpath
  64. conv
  65.  
  66. moveto
  67. conv
  68. lineto
  69. closepath
  70. setgray
  71. stroke
  72. }def
  73.  
  74. /square  %stack y2 x2 y1 x1 graylevel
  75. {
  76. conv
  77. /y2 exch def
  78. /x2 exch def
  79. conv
  80. /y1 exch def
  81. /x1 exch def
  82.  
  83. newpath
  84. x1 y1 moveto
  85. x2 y1 lineto
  86. x2 y2 lineto
  87. x1 y2 lineto
  88. x1 y1 lineto
  89. closepath
  90. setgray
  91. stroke
  92. } def
  93.  
  94. /errorbar   % stack size, y x graylevel
  95. {
  96. newpath
  97. % get size into point
  98. % s'=s*(symax-symin)/(ymax-ymin)
  99.  
  100. symax symin sub
  101. ymax ymin sub
  102. div mul
  103.  
  104. /size exch def % set size=converted size
  105. conv % convert x&y coods
  106. moveto
  107. 0 size rlineto
  108. -10 0  rlineto
  109. 20 0  rlineto
  110. -10 0  rlineto
  111. 0 size -2 mul rlineto
  112. -10 0  rlineto
  113. 20 0  rlineto
  114. setgray
  115. stroke
  116. }def
  117.  
  118. /point  % y x symbol gray
  119. {
  120. /y exch def
  121. /x exch def
  122. /symbol exch def
  123. /gray exch def
  124.  
  125. /sx x xconv def
  126. /sy y yconv def
  127.  
  128. %0=blank
  129.  
  130. symbol 1 eq 
  131. { gray sx 3 sub sy 3 sub sx 3 add sy 3 add squ} if     %1= square
  132. symbol 2 eq  % 2= circle
  133. {gray sx sy 4 circle} if
  134. symbol 3 eq  % 3= up triangle
  135. { gray sx sy 6 1 tria} if   
  136. symbol 4 eq  % 4= X
  137. {gray sx sy 4 cross} if
  138. symbol 5 eq  % 5= diamond
  139. {gray sx sy 5 diamond} if
  140. symbol 6 eq % 6= down triangle
  141. { gray sx sy 6 -1 tria} if
  142. symbol 7 eq % 7 =star
  143. {gray sx sy 5 star} if
  144. } def
  145.  
  146. /diamond %size y x gray
  147. {
  148. newpath
  149.  
  150. /size exch def
  151.  
  152. moveto
  153.  
  154. 0 size 2 div rmoveto
  155. size -2 div size -1 mul rlineto 
  156. size 2 div  size -1 mul rlineto
  157. size 2 div size  rlineto
  158. size -2 div size rlineto
  159. setgray
  160. stroke
  161.  
  162. }def
  163.  
  164. /cross % size y x gray
  165. {
  166. /size exch def
  167. /y exch def
  168. /x exch def
  169. newpath
  170. x size add y size add moveto
  171. x size sub y size sub lineto
  172. x size sub y size add moveto
  173. x size add y size sub lineto
  174. setgray
  175. stroke
  176. } def
  177.  
  178. /star % size y x gray
  179. {
  180. /size exch def
  181. /y exch def
  182. /x exch def
  183. newpath
  184. gsave
  185. x y translate
  186. 0 15 360
  187. {rotate 0 0 moveto 0 size lineto} for
  188. setgray
  189. stroke
  190. grestore
  191. } def
  192.  
  193.  
  194. /tria % updn size y x gray
  195. {
  196. newpath
  197.  
  198. /updn exch def
  199.  
  200. /size exch def
  201. moveto
  202. 0 size 2 div updn mul rmoveto
  203. size -2 div size -1 mul updn mul rlineto 
  204. size 0 rlineto
  205. size -2 div size updn mul rlineto
  206. setgray
  207. stroke
  208.  
  209. }def
  210.  
  211. /squ  %stack y2 x2 y1 x1 graylevel
  212. {
  213. /y2 exch def
  214. /x2 exch def
  215. /y1 exch def
  216. /x1 exch def
  217.  
  218. newpath
  219. x1 y1 moveto
  220. x2 y1 lineto
  221. x2 y2 lineto
  222. x1 y2 lineto
  223. x1 y1 lineto
  224. closepath
  225. setgray
  226. stroke
  227. } def
  228.  
  229.  
  230. /circle  % r y x gray
  231. {
  232. newpath
  233. 0 360 arc
  234. setgray
  235. stroke
  236. }def
  237.  
  238. /grid % stack (top) tky tkx gray
  239. {
  240. initclip
  241. newpath
  242. /tky exch def
  243. /tkx exch def
  244. /gray exch def
  245.  
  246. /xstep xmax xmin sub tkx div def
  247. /ystep ymax ymin sub tky div def
  248.  
  249. /i xmin def
  250.  
  251. [1 3] 0 setdash % make a dotted line
  252.  
  253. 0 1 tkx 
  254. {
  255. gray i ymin i ymax plotline
  256.  
  257. /i i xstep add def  % i=i+xstep
  258. } for
  259.  
  260.  
  261. /i ymin def
  262.  
  263. 0 1 tky
  264. {
  265. gray xmin i xmax i plotline
  266.  
  267. /i i ystep add def % i=i+ ystep
  268. } for
  269.  
  270. [] 0 setdash % back to a solid line
  271. stroke
  272. 0.0 xmin ymin xmax ymax square  %put a box around the graph
  273. }def
  274.  
  275. /text % txt pointsize font y x note x,y are in point coordinates!
  276. {
  277.  
  278. /txt exch def
  279.  
  280. /pointsize exch def
  281.  
  282. /font exch def
  283.  
  284. /y exch def
  285. /x exch def
  286.  
  287.  
  288.  
  289.  
  290. font findfont
  291.  
  292. 0 setgray
  293.  
  294. %Helvetic-Bold
  295. %Symbol
  296. %Times-Italic
  297.  
  298. pointsize
  299. scalefont
  300. setfont
  301.  
  302. x -1 eq % if x==-1
  303. { txt stringwidth pop 2 div % get xoffset and divide it by 2
  304.   sxmax sxmin sub 2 div sxmin add exch sub  
  305.   /x exch def % x=(xmax-xmin)/2 + xmin - xoffset
  306.  } if
  307.  
  308. y -1 eq % if y==-1
  309. {
  310.  txt stringwidth exch pop 2 div % get yoffset and divide it by 2
  311.  symax symin sub 2 div symin add exch sub /y exch def %y=(ymax-ymin)/2+ymin-yoffset
  312. } if
  313.  
  314. x y moveto
  315. txt show
  316. } def
  317.  
  318.  
  319.  
  320. /vtext % txt pointsize font y x   *** x,y are in point coordinates!
  321. {
  322.  
  323. /txt exch def
  324.  
  325. /pointsize exch def
  326.  
  327. findfont
  328.  
  329. 0 setgray
  330.  
  331. pointsize
  332. scalefont
  333. setfont
  334. /y exch def
  335. /x exch def
  336.  
  337. x -1 eq % if x==-1
  338. { txt stringwidth pop 2 div % get xoffset and divide it by 2
  339.   sxmax sxmin sub 2 div sxmin add exch sub  
  340.   /x exch def % x=(xmax-xmin)/2 + xmin - xoffset
  341.  } if
  342.  
  343. y -1 eq % if y==-1
  344. {
  345.  txt stringwidth exch pop 2 div % get yoffset and divide it by 2
  346.  symax symin sub 2 div symin add exch sub /y exch def %y=(ymax-ymin)/2+ymin-yoffset
  347. } if
  348.  
  349. x y translate
  350. 90 rotate
  351. 0 0 moveto
  352. txt show
  353. -90 rotate
  354. x -1 mul y -1 mul translate
  355. } def
  356.  
  357. /herrorbar   % stack size, y x graylevel
  358. {
  359. newpath
  360. % get size into point
  361. % size'=size*(sxmax-sxmin)/(xmax-xmin)
  362. sxmax sxmin sub mul
  363. xmax xmin sub div
  364.  
  365. /size exch def % set size=converted size
  366. conv % convert x&y coods
  367. moveto
  368. size 0 rlineto
  369. 0 -10  rlineto
  370. 0 20   rlineto
  371. 0 -10  rlineto
  372. size -2 mul 0 rlineto
  373. 0 -10  rlineto
  374. 0  20 rlineto
  375. setgray
  376. stroke
  377. }def
  378.  
  379. /doclipping
  380. {
  381. %setup clipping
  382. newpath
  383. sxmin symin moveto
  384. sxmax symin lineto
  385. sxmax symax lineto
  386. sxmin symax lineto
  387. sxmin symin lineto
  388. clip
  389.  
  390. }def
  391.  
  392.  
  393. /polynom  % stack (top) max min N a[n-1] ... a[0] gray
  394. {
  395. /max exch def
  396. /min exch def
  397. /N exch def
  398.  
  399. /coeff N array def % coefficints array size of N
  400.  
  401. newpath
  402.  
  403. N 1 sub
  404.   {
  405.   /index exch def
  406.   index    coeff   % move a[i] before i on stack 
  407.   3 1 roll % stack (top) a[j] i array
  408.   exch
  409.   put  % put into array
  410.   index 0 le  % exit if i<=0
  411.   {exit} if 
  412.   index 1 sub % i-1
  413.   } loop
  414.  
  415.    %step= (max-min)/(sxmax-sxmin)
  416. /step max min sub sxmax sxmin sub div def
  417. % x=min to max  
  418. min  
  419.  {
  420.  /x exch def
  421.  /y 0 def
  422.    %do j=0 to n-1 
  423.  
  424.  
  425.     0
  426.     {
  427.        /j exch def
  428.        /y x j power coeff j get mul y add def % y += x^j * a[j]
  429.        j  N 1 sub  ge % if j >= N-1 exit
  430.        {exit} if
  431.        j 1 add
  432.     } loop
  433.  % if x=min moveto else lineto...
  434.  x y
  435.  conv
  436.  x min eq % x==min
  437.  {moveto } { lineto} ifelse
  438. % 
  439. % 
  440. %
  441.  x max ge % if x>= max exit
  442.  { exit} if
  443.  x step add
  444.  } loop
  445. %closepath
  446. setgray
  447. stroke
  448. }def
  449.  
  450. /power %(args) n x
  451. {
  452. /n exch def
  453. /x exch def
  454. /ret 1.0 def
  455.  
  456.  1 % i=1 while i< n
  457.  {
  458.  /in exch def
  459.  /ret ret x mul def % ret *= x;
  460.  in n ge % i>=n
  461.  {exit} if
  462.  in 1 add
  463.  }loop
  464.  
  465. n 1 eq
  466. { /ret x def } if
  467.  
  468. n 0 eq
  469. {/ret 1.0 def} if
  470.  
  471. ret
  472. }def
  473.  
  474.  
  475. doclipping % set up clipping
  476.